﻿<!--#include file="const.inc"-->
<%
'====================================================================
' 感谢使用晴天3G智能建站系统..
' 作者:梁永强.QQ:766750857
' 官方网址:wap.qt3g.com
' 声明:软件版权归作者所有,没有经过作者本人同意不得非法破解和传播本程序
'====================================================================
%>
<%
if sid="Null" then
Response.Redirect "/login.asp?sid=" & sidd & "&url=/diy/Transfmp3.asp"
Response.end
end if
bitttt=qingtian.confff("bit")
bittt=conn.execute("select money from [qingtian_user] where sid='"&qingtian.Formatsid(sid)&"'")("money")
select case v
case "0"
we0="<br/>"
hr="-----------<br/>"
%>
<card title="爱情彩字"><p align="<%=qingtian.px%>">
<%
case "1"
zi="<span style=""color:#FF5500"">"
we="<div class=""footer"">"
sou="<div class=""block4"">"
dao="<div class=""navi"">"
we0="</div>"
we1="</div>"
%>
<title>爱情彩字</title>
</head>
<body>
<!--#include virtual="/css.inc"-->
<%

End Select
%>
<%=qingtian.qingsav("10086")%>
<%
on error resume next
Dim fs, f, f1, fc,cs,i,fsod,Filedel
i=0 
Filepath=Server.MapPath("/diy/Images/")
Set fs = CreateObject("Scripting.FileSystemObject") 
Set f = fs.GetFolder(Filepath)
Set fc = f.Files
For Each f1 in fc
i=i+1
Next
If i>30 Then
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(Filepath)
Set fc = f.Files
For Each f1 in fc
Filedel=Filepath&"/"&f1.name
set fsod = createobject("scripting.filesystemobject")
If (fsod.fileexists(Filedel)) Then
fsod.deletefile(Filedel)
End If
set fsod = Nothing
i=i+1
Next
End If
Response.Write(""&dao&"=爱情彩字="&we0&""&we&"")
if Request.QueryString("act")=1 then
if session("uurl")<>"" then
Response.Write qingtian.touxian(session("uurl"))
else
Response.Write "设为头像失败!"
end if
session("uurl")=""
Response.Write "<br/>"
end if
Dim backurl,mo2,mob,ii,filename1,cc
filename1="LoveColor.asp"	'本文件名
cc=clng(request("cc"))
backurl=request("backurl")
cc=clng(request("cc"))
backurl=Replace(backurl,"@@","&")
If left(backurl,1)<>"/" Then backurl="/"&backurl
mo2=split(backurl,".")
mob=lcase(mo2(ubound(mo2)))	'字符变小写参数前加
ii="jpg|gif|bmp|jpeg|peg|png|jpge|mid|midi|mmf|amr|img|adp|m4a|mp3|aac|wav|wma|ogg|avi|mp4|3gp|wmv|rm|rmvb|dat|mpg|asf|umd|txt|chm|brm|prc|pdb|mdx|trc|sis|sisx|jar|jad|cab|mpkg|hme|ski|thm|uiq|nth|utz|mtf|sdt|tsk|nec|nes|gba|gb|gbc|gba|fba|md|sfc|smc|lrc|nol|rar|zip|7z|emz|pdf|pdg"
If instr(ii,mob)>0 Then
Response.redirect "http://www.czxiu.com"&backurl
Response.End
End If
%>
<%
text1=TRim(Request("text1"))
id1=TRim(Request("id1"))
If text1<>"" and id1<>"" Then
If bittt<bitttt and qingtian.vip(qingtian.nid)<>"VIP会员" Then 
Response.Write "出错了！你的"&qingtian.bi&"不够哦！"
else
if len(text1)>20 then
Response.Write "错误，最大支持文字20个字符！<br/>"
Else
t_sks=1200
t_text=Application(filename1 & sid & curl & text1 & id1)
If t_text="" or DateDiff("s",t_text,now())>t_sks Then		'缓存为空时，读取远程数据
Url="http://www.czxiu.com/m.php?k=&w=" & server.urlencode(text1) & "&s=" & id1 & ""	'传送过去的内容
wstr=qingtian.getHTTPPage1(url)
start=Instr(wstr,"OK: .")+0
over=Instr(wstr,".gif")+4
body=mid(wstr,start,over-start)
'以下替换内容
body = replace(body,Chr(10),"")
body = replace(body,Chr(13),"")
body = replace(body,"""","'")
body = replace(body,vbndwline,"")
body = replace(body,vbLf,"")
body = replace(body,vbCr,"")
body = replace(body,"OK: .","")
'body = replace(body,"%","%25")
body = replace(body,"","")
body = replace(body,"","")
'-------------------------------------
	Set re=new RegExp
	re.IgnoreCase =true
	re.Global=True
'	re.pattern="/z/([\s\S]+?).gif"
'	body= re.Replace(body,"制作成功！<br/><img src='" & filename1 & "?backurl=/z/$1.gif' alt='" & Request("name") & "制作成功'/><br/><a href='" & filename1 & "?backurl=/z/$1.gif'>下载到手机</a>")
	re.pattern=""
	body= re.Replace(body,"")
	re.pattern=""
	body= re.Replace(body,"")
'	re.pattern="<a href='([^h])"
'	body= re.Replace(body,"<a href='" & filename1 & "?backurl=$1")
	set re=Nothing
'-------------------------------------
If len(body)<1 Then
Response.Write "对不起，由于网络原因数据获取失败，请稍候再试！<br/>"
Else
'Application(filename1 & sid & curl & name & id)=body
'Response.Write body
'End If
'Else '直接输出缓存
'Response.Write t_text
'End If
'Response.Write "<br/>"
'End If
'End If
%>
<%
RemoteFileUrl ="http://www.czxiu.com" & body & "" 
FileExt = right(RemoteFileUrl,4) 
randomize
ranNum = int(9*10^3*rnd)+10^3
dtNow = Now()
FileName = year(date) & month(date) & day(date) & "0" & minute(now()) & second(now()) & "_" & Replace(Request.ServerVariables("Server_NAME"),".",".") & FileExt
LocalFileName = "/diy/images/" 
If right(LocalFileName,1) <> "/" Then LocalFileName = LocalFileName & "/"
SaveFile = server.mappath(LocalFileName & FileName)
SaveRemoteFile SaveFile,RemoteFileUrl 
saveimg=LocalFileName & FileName 
uurl=saveimg
session("uurl")=uurl
Dim filetest,filesize
set filetest=server.CreateObject("Scripting.FileSystemObject")
filesize=filetest.GetFile(server.MapPath(uurl)).size
If filesize<>"" and filesize>0 Then
if qingtian.vip(qingtian.nid)="VIP会员" then
qingtian.addong("在[url=/diy/LoveColor.asp?sid=[sid]]爱情彩字[/url]制作了彩字")
Response.Write Right(body,3) & "制作成功，文件大小为" & FormatNumber(filesize/1024,1) & "KB<br/>"
Response.Write "<img src='" & uurl & "' alt='Load...'/><br/>"
Response.Write "<a href='" & uurl & "'>免费下载</a>.<a href='" & filename1 & "?act=1&amp;sid=" & sidd & "'>设为头像</a><br/>"
else
qingtian.payy("-"&bitttt)
qingtian.addong("在[url=/diy/LoveColor.asp?sid=[sid]]爱情彩字[/url]制作了彩字")
Response.Write Right(body,3) & "制作成功，文件大小为" & FormatNumber(filesize/1024,1) & "KB<br/>系统自动扣除你"&bitttt&""&qingtian.bi&"<br/>你现在的"&qingtian.bi&":"&bittt&"<br/>"
Response.Write "<img src='" & uurl & "' alt='Load...'/><br/>"
Response.Write "<a href='" & uurl & "'>免费下载</a>.<a href='" & filename1 & "?act=1&amp;sid=" & sidd & "'>设为头像</a><br/>"
end if
Else
Response.Write "对不起，由于网络原因图片获取失败，请稍候再试！<br/>"
End If
set filesize=nothing
set filetest=nothing
End If
End If
End If
End If
End If
%>
<%=we1%><%=hr%><%=sou%>注意:<%=zi%>普通会员每次制作系统自动扣除<%=bitttt%><%=qingtian.bi%>(VIP会员免费制作)<%=zi0%><%=we0%>
<%
        if v=1 then
	%>
        <form action="<%=filename1%>?sid=<%=sidd%>" method="post">
<%=we%>
输入文字(最多20字)<br/>
<textarea name="text1" rows="3"/></textarea><br/>
        <%
        else
	%>
输入文字(最多20字)<br/>
<input name="text1" type="text" maxlength="20" value=""/><br/>
        <%
        end if
        %>
图片样式<%if len(id1)<>0 then%><select name="id1" value="<%=id1%>">
<%else%><select name="id1">
<%end if%>
<option value="2009qingren">情人节卡片(最多18字)</option>
<option value="f_sz_l">浪漫留言(最多20字)</option>
<option value="0903pig">亲爱的想你了(最多10字)</option>
<option value="pigkiss">相爱的小猪(最多8字)</option>
<option value="siben">私奔(最多8字)</option>
<option value="hnote">爱的留言(最多17字)</option>
<option value="flylove">飞翔的爱(最多14字)</option>
<option value="0807iloveyou">我爱你(最多8字)</option>
<option value="flshearts">蓝蓝心心相印(最多7字)</option>
<option value="marrycert">结婚证书(最多8字)</option>
<option value="loveyou">恩爱夫妻(最多16字)</option>
<option value="happyhouse">爱情小屋(最多8字)</option>
<option value="iloveyou">我爱你(最多3字)</option>
<option value="kissn">亲N个(最多10字)</option>
<option value="moneyflower">钱花(最多11字)</option>
<option value="ysjt_biaobai">爱情表白(最多10字)</option>
<option value="071109_kissbaby">亲亲宝贝(最多14字)</option>
<option value="qqlove">老婆大人辛苦了(最多8字)</option>
<option value="photolove">我爱老婆(最多8字)</option>
<option value="f_sz_v">爱你的心(最多12字)</option>
<option value="marryme">嫁给我吧(最多8字)</option>
<option value="monk_love">猴子的爱情(最多10字)</option>
<option value="l_apple">水晶苹果(最多8字)</option>
<option value="love_old">一起变老(最多2字)</option>
<option value="h_bluesky">心想事成(最多4字)</option>
<option value="77895">紧紧抱紧我(最多6字)</option>
<option value="rear">背后纹身(最多9字)</option>
<option value="0811with">带你去旅行(最多4字)</option>
</select><br/>
        <%
        if v=0 then
Response.Write "<anchor title=""submit"">提交制作<go href=""" & filename1 & "?sid=" & sidd & """ method=""post"">"
%>
<postfield name="text1" value="$(text1)"/>
<postfield name="id1" value="$(id1)"/>
</go>
</anchor><br/>
        <%
        else
	%><%=we1%>
        <input type="submit" value="提交制作"/>
        </form><br/>
	<%
	end if
	%>
<%=we%><%=hr%>
快告诉你的朋友来这里玩玩吧,古话说的好,独乐乐不如众乐乐.<%=we0%>
<%=sou%><a href='index.asp?sid=<%=sidd%>'>返回制作首页</a><%=we0%>
<%
End function
Sub SaveRemoteFile(LocalFileName,RemoteFileUrl)
Dim Ads,Retrieval,GetRemoteData
Set Retrieval = Server.CreateObject("Microsoft.XMLHTTP")
With Retrieval
.Open "Get", RemoteFileUrl, False, "", ""
.Send
GetRemoteData = .ResponseBody
End With
Set Retrieval = Nothing
Set Ads = Server.CreateObject("Adodb.Stream")
With Ads
.Type = 1
.Open
.Write GetRemoteData
.SaveToFile LocalFileName,2
.Cancel()
.Close()
End With
Set Ads=nothing
End sub
%>
